home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 52
/
Amiga Format AFCD52 (Issue 136, May 2000).iso
/
-serious-
/
programming
/
basic
/
mildred
/
mildred.lha
/
lha
/
LandTest6.lha
/
LandTest6.ascii
< prev
next >
Wrap
Text File
|
1999-05-24
|
21KB
|
705 lines
.Demo
WBStartup
DEFTYPE.w
Pic$="shape25tiny.IFF" ; 10 onwards
Pic2$="shape17tiny.IFF"
Pic3$="shape16tiny.IFF"
Pic4$="shape19tiny.IFF"
Land$="Land17.iff"
DoLand=True
Sky$="Sky39.iff" ;2;3;4;6;9;10;12;16;19;22
DoSky=True
#Objects=150 ;25;55;150;280;400
DoObjects=True
#ObjWidth=32 ;128;64;32;16;8
#ObjHeight=32 ;64;64;32;16;8
#StarsPerSpeed=15
DoStars=False
DoRainbow=True
*ScrVP.ViewPort=0
IsAGA.b=True ; Defaults to AGA
Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers)
PrefDisplayID.l=$0 ; Default ModeID (Pal:LowRes, or promotes to DoublePal:LowRes)
PrefDisplayWidth.w=320 ; Default Width
PrefDisplayHeight.w=240 ; Default Height
PrefDisplayBuffering.b=3 ; 1..3. 1=Singlebuffered, 2=Doublebuffered, 3=Triplebuffered
PrefDisplayMethod.b=1 ; 0=WritePixelArray8/WriteChunkyPixels, 1=MBlockScroll, 2=WritePixelArray(CGFX)
PrefCGFXLock.b=True ; Wether when Method=1, CGFX LockBitmap will be attempted for safety and to get base address
OSVersion.w=ExecVersion
#DTAG_DISP=$80000000
#DTAG_DIMS=$80001000
#DTAG_MNTR=$80002000
#DTAG_NAME=$80003000
#LBMI_BASEADDRESS=$84001007
#DIPF_IS_FOREIGN=$80000000
#DIPF_IS_ECS=$00000010
#DIPF_IS_AGA=$00010000
Function.b CheckLib{Lib$,LibVer}
;Returns wether a specific library is available or not
*lib.l=OpenLibrary_(&Lib$,LibVer)
If *lib
CloseLibrary_ *lib
Function Return True
Else
Function Return False
EndIf
End Function
CGFXAvail.b=CheckLib{"cybergraphics.library",0}
If Joyb(0)=0 AND Joyb(1)=0 AND CGFXAvail=False Then Goto SkipSMR
NEWTYPE.SMode
DID.l
DWidth.l
DHeight.l
DDepth.w
DType.w
End NEWTYPE
DEFTYPE.Hook myhook ; The hook for ASL tag as &myhook
myhook\h_Entry=?hook
MOVE.l a5,globalbase
funcret.l=0
Dim SMRtags.TagItem(17)
SMRtags(0)\ti_Tag=#ASLSM_InitialLeftEdge,160 ; X coord of requester
SMRtags(1)\ti_Tag=#ASLSM_InitialTopEdge,0 ; Y coord of requester
SMRtags(2)\ti_Tag=#ASLSM_InitialWidth,300 ; Width of requester
SMRtags(3)\ti_Tag=#ASLSM_InitialHeight,400 ; Height of requester
SMRtags(4)\ti_Tag=#ASLSM_InitialDisplayID,$21000 ; Default ModeID (Pal:LowRes)
SMRtags(5)\ti_Tag=#ASLSM_InitialDisplayDepth,8 ; Default depth (8-bit usually)
SMRtags(6)\ti_Tag=#ASLSM_InitialDisplayWidth,PrefDisplayWidth
SMRtags(7)\ti_Tag=#ASLSM_InitialDisplayHeight,PrefDisplayHeight
SMRtags(8)\ti_Tag=#ASLSM_InitialOverscanType,1 ; Default overscan type (Text)
SMRtags(9)\ti_Tag=#ASLSM_InitialInfoOpened,1 ; Info window?
SMRtags(10)\ti_Tag=#ASLSM_InitialInfoLeftEdge,350 ; X coord of info window
SMRtags(11)\ti_Tag=#ASLSM_InitialInfoTopEdge,50 ; Y coord of info window
SMRtags(12)\ti_Tag=#ASLSM_DoDepth,0 ; Depth gadget? (Generally NO for chunky 8-bit)
SMRtags(13)\ti_Tag=#ASLSM_DoOverscanType,0 ; Overscan gadget?
SMRtags(14)\ti_Tag=#ASLSM_DoWidth,0 ; Width gadget?
SMRtags(15)\ti_Tag=#ASLSM_DoHeight,0 ; Height gadget?
SMRtags(16)\ti_Tag=#ASLSM_FilterFunc,&myhook ; Address of callback hook routine
SMRtags(17)\ti_Tag=#TAG_DONE,0
*sreq.SMode=0
*sreq=AllocAslRequest_(2,&SMRtags(0)\ti_Tag)
ok.b=AslRequest_(*sreq,&SMRtags(0)\ti_Tag)
If ok<>0
PrefDisplayID.l=*sreq\DID
PrefDisplayWidth.w=*sreq\DWidth
PrefDisplayHeight.w=*sreq\DHeight
EndIf
If (*sreq) Then FreeAslRequest_(*sreq)
Goto SkipSMR
;*************************************************************************
; This is the statement that the hook will call. Put the label before
; the statement you want to jump to.
Runerrsoff
hook_jump:
Statement hook{*dahook.Hook, modeID.l, *smr.ScreenModeRequester}
; We're inside the hook, and supposedly we should be able to do whatever
; we want.
; Filter modeID's here
SHARED funcret.l
DEFTYPE.DisplayInfo DisInfoBuf
DEFTYPE.DimensionInfo DimInfoBuf
DEFTYPE.MonitorInfo MonInfoBuf
DEFTYPE.NameInfo NamInfoBuf
;Refer to Includes/Graphics/DisplayInfo.h or view newtypes
IDhandle.l=FindDisplayInfo_(modeID)
GetDisplayInfoData_ IDhandle,&DisInfoBuf,SizeOf.DisplayInfo,#DTAG_DISP,0
GetDisplayInfoData_ IDhandle,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
GetDisplayInfoData_ IDhandle,&MonInfoBuf,SizeOf.MonitorInfo,#DTAG_MNTR,0
GetDisplayInfoData_ IDhandle,&NamInfoBuf,SizeOf.NameInfo,#DTAG_NAME,0
;Do tests. True=Mode is valid, False=mode is invalid.
;See newtypes for DisplayInfo,DimensionInfo,MonitorInfo and NameInfo for things to further test
If DimInfoBuf\MaxDepth<>8
;No true-colour modes, only 8-bit
funcret=False
Else
If DimInfoBuf\TxtOScan\MaxX>320-1
;No hires modes
funcret=False
Else
If DimInfoBuf\TxtOScan\MaxY<240-1 OR DimInfoBuf\TxtOScan\MaxY>256-1
;Not too short
funcret=False
Else
funcret=True
EndIf
EndIf
EndIf
End Statement
;**********************
; Hook
Macro goto_hook
JSR `1+6
End Macro
globalbase: Dc.l 0
hook: ;This hook is called by the filter hook callback from screenmode requester, per item
; Store registers
MOVEM.l d1-d7/a0-a6,-(a7) ; Not d0!
; Put parameters into dregs ready for a statement
MOVE.l a0,d0
MOVE.l a1,d1
MOVE.l a2,d2
; Get global variable base
MOVE.l globalbase,a5
; Goto hook statement
!goto_hook{hook_jump}
GetReg d0,funcret ; return accept/discard
; Restore registers
MOVEM.l (a7)+,d1-d7/a0-a6 ; Not d0!
RTS
;**********************
Runerrson
.SkipSMR
Function.b InitDisplay{Title$}
;Creates a display for AGA or Graphics-Card output
;Title$=The screen title (not displayed)
SHARED PrefDisplayWidth,PrefDisplayHeight,PrefDisplayBuffering
SHARED *ScrVP,PrefDisplayID,IsAGA,PlanarBuf(),CGFXAvail
;Setup a test screen
Dim ScrTags.TagItem(13)
Rect.Rectangle\MinX=0,0,320,240 ; For test
ScrTags(0)\ti_Tag=#SA_Width,320 ; For test
ScrTags(1)\ti_Tag=#SA_Height,240; For test
ScrTags(2)\ti_Tag=#SA_Depth,8
ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
ScrTags(4)\ti_Tag=#SA_Type,$F
ScrTags(5)\ti_Tag=#SA_Quiet,True
ScrTags(6)\ti_Tag=#SA_ShowTitle,False
ScrTags(7)\ti_Tag=#SA_Behind,True
ScrTags(8)\ti_Tag=#SA_DClip,&Rect ; For test
ScrTags(9)\ti_Tag=#SA_Exclusive,False
ScrTags(10)\ti_Tag=#SA_Draggable,False
ScrTags(11)\ti_Tag=#SA_AutoScroll,False
ScrTags(12)\ti_Tag=#TAG_DONE,0
ScrTags(13)\ti_Tag=#TAG_DONE,0
If CGFXAvail
IsAGA=1-(IsCyberModeID_(PrefDisplayID))
Else
; Need to do a test
UsedChip.l=320*240 ; With test params (depth 8)
FreeChip.l=AvailMem_(#MEMF_CHIP)
Forbid_
If ScreenTags(0,Title$,&ScrTags(0))
NowChip.l=AvailMem_(#MEMF_CHIP)
Permit_
If FreeChip-NowChip<UsedChip
IsAGA=False
Else
IsAGA=True
EndIf
VWait 5
Free Screen 0
VWait 5
Else
; Failed to open, so resort to fixed AGA LowRes
Permit_
IsAGA=True
PrefDisplayID=0
PrefDisplayWidth=320
PrefDisplayHeight=240
EndIf
EndIf
If IsAGA
PrefDisplayHeight=240
PrefDisplayWidth AND $FFC0 ; Multiples of 64 for AGA
Else
PrefDisplayWidth AND $FFF0 ; Multiples of 16 for graphics card
EndIf
ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
ScrTags(8)\ti_Tag=#SA_DClip,&Rect
If IsAGA
; AGA display
ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers
ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
Forbid_
For Loop.w=0 To PrefDisplayBuffering-1
If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
If AvailMem_(#MEMF_CHIP)>=(PrefDisplayWidth*PrefDisplayHeight)+16
Memory.l=AllocMem((PrefDisplayWidth*PrefDisplayHeight)+16,$10002) ; Chipram bitmap
Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's
If Memory
CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,8,Memory ; Depth 8
If Loop=0
ScrTags(12)\ti_Tag=#SA_BitMap,Addr BitMap(0)
If ScreenTags(0,Title$,&ScrTags(0))=0
Permit_
Function Return False
EndIf
EndIf
If Window(Loop,0,0,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
Menus Off
Else
Permit_
Function Return False
EndIf
Else
Permit_
Function Return False
EndIf
PlanarBuf(Loop)=Memory
Next Loop
Permit_
Else
; Graphics-card display
ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight*PrefDisplayBuffering
If ScreenTags(0,Title$,&ScrTags(0))
For Loop.w=0 To PrefDisplayBuffering-1
If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
If Window(Loop,0,PrefDisplayHeight*Loop,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
Menus Off
ScreensBitMap 0,Loop
*TmpBmp.bitmap=Addr BitMap(Loop)
Offset.l=*TmpBmp\_ebwidth*(PrefDisplayHeight*Loop)
For DLoop.w=0 To 8-1 ; Depth of 8
*TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset
Next DLoop
Next Loop
Else
Function Return False
EndIf
EndIf
If Peek.l(Addr Screen(0))
DEFTYPE.DimensionInfo DimInfoBuf
GetDisplayInfoData_ FindDisplayInfo_(PrefDisplayID) AND $FFFFFFFF,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
PrefDisplayLeft.w=((DimInfoBuf\TxtOScan\MaxX)-PrefDisplayWidth)/2
PrefDisplayTop.w=((DimInfoBuf\TxtOScan\MaxY)-PrefDisplayHeight)/2
*Scr.Screen=Peek.l(Addr Screen(0))
*ScrVP=ViewPort(0)
*ScrVP\DxOffset=PrefDisplayLeft,PrefDisplayTop
ScrollVPort_ *ScrVP
RethinkDisplay_
Menus Off
If *ScrVP\DHeight<>PrefDisplayHeight
Forbid_
*Scr\Height=PrefDisplayHeight ; Enforce y clipping
Permit_
EndIf
ScreenToFront_ *Scr
Function Return True
Else
Function Return False
EndIf
End Function
.Main
If CGFXAvail=False AND PrefDisplayMethod=2 Then PrefDisplayMethod=0
If InitDisplay{"Game"}=False Then Goto Finish
If PrefDisplayMethod=0 AND OSVersion<40
MBitmap 5,PrefDisplayWidth,PrefDisplayHeight ; Temporary bitmap to allow WPA8 instead of WPL8's
EndIf
InitBank 0,2880*60,$10000
CludgeBitMap 3,2880,60,8,Bank(0)
LoadBitMap 3,Land$
MBitmap 2,2880,60
MPlanar16ToBitmap 2,Bank(0)
InitBank 0,320*240,$10000
CludgeBitMap 3,320,240,8,Bank(0)
MGetaShape 0,1120,0,16,27
MBitmap 1,PrefDisplayWidth,170 ; 150 gfx card, 164 AGA
MBitmap 0,PrefDisplayWidth+#ObjWidth,PrefDisplayHeight+#ObjHeight+#ObjHeight
InitShape 0,16,1,2
WPointer 0
If IsAGA Then Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight,PrefDisplayWidth+#ObjWidth,PrefDisplayWidth,PrefDisplayHeight
InitPalette 1,256
InitPalette 0,256
Cls 0
LoadBitMap 3,Pic$,0
MShape 1,#ObjWidth,#ObjHeight
MPlanar16ToShape 1,Bank(0),#ObjWidth,#ObjHeight,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie 1
For c=0 To 31
CopyColour 0,1,c,64+c
Next c
For c=1 To 31
MReMapShape c,64+c,1
Next c
Cls 0
LoadBitMap 3,Pic2$,0
MShape 2,#ObjWidth,#ObjHeight
MPlanar16ToShape 2,Bank(0),#ObjWidth,#ObjHeight,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie 2
For c=0 To 31
CopyColour 0,1,c,64+32+c
Next c
For c=1 To 31
MReMapShape c,64+32+c,2
Next c
Cls 0
LoadBitMap 3,Pic3$,0
MShape 3,#ObjWidth,#ObjHeight
MPlanar16ToShape 3,Bank(0),#ObjWidth,#ObjHeight,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie 3
For c=0 To 31
CopyColour 0,1,c,128+c
Next c
For c=1 To 31
MReMapShape c,128+c,3
Next c
Cls 0
LoadBitMap 3,Pic4$,0
MShape 4,#ObjWidth,#ObjHeight
MPlanar16ToShape 4,Bank(0),#ObjWidth,#ObjHeight,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie 4
For c=0 To 31
CopyColour 0,1,c,128+32+c
Next c
For c=1 To 31
MReMapShape c,128+32+c,4
Next c
Cls 0
LoadBitMap 3,Sky$,0
MPlanar16ToBitmap 1,Bank(0),PrefDisplayWidth,150,PrefDisplayWidth,PrefDisplayHeight
For c=64 To 127
MReMap c,128+c,1
CopyColour 0,1,c,128+c
Next c
For c=0 To 63
CopyColour 0,1,c,c
Next c
NumberOfShapes.w=4
LoadRGB32_ *ScrVP,Peek.l(Addr Palette(1))
NEWTYPE.xy
x.w
y.w
End NEWTYPE
Dim pos.xy(#Objects)
Dim pos2.xy(#Objects)
Dim direction.xy(#Objects)
For obj=1 To #Objects
pos(obj)\x=Rnd(2239-#ObjWidth)
pos(obj)\y=Rnd(PrefDisplayHeight-#ObjHeight-60-14-16)+8
Repeat
direction(obj)\x=Rnd(8)-4
Until direction(obj)\x<>0
direction(obj)\y=Rnd(6)-3
Next obj
NEWTYPE.xyq
x.q
y.q
End NEWTYPE
Dim star1.xyq(#StarsPerSpeed)
Dim star2.xyq(#StarsPerSpeed)
Dim star3.xyq(#StarsPerSpeed)
Dim star4.xyq(#StarsPerSpeed)
Dim star5.xyq(#StarsPerSpeed)
For s=1 To #StarsPerSpeed
star1(s)\x=Rnd(319)
star1(s)\y=Rnd(120)
star2(s)\x=Rnd(319)
star2(s)\y=Rnd(100)
star3(s)\x=Rnd(319)
star3(s)\y=Rnd(80)
star4(s)\x=Rnd(319)
star4(s)\y=Rnd(60)
star5(s)\x=Rnd(319)
star5(s)\y=Rnd(40)
Next s
speedsetting.q=1 ; Global speed multiplier
xpos.q=0
xaccelerate.q=1*speedsetting
xmomentum.q=0
xairresistance.q=0;.1*speedsetting
xmaxspeed.q=16*speedsetting
ypos.q=(PrefDisplayHeight-69)/2
yaccelerate.q=0.7*speedsetting
ymomentum.q=0
ymaxspeed.q=8*speedsetting
ytopdampen.q=1.9
ybottomdampen.q=1.65
ygravity.q=0.15;*speedsetting
NEWTYPE.OffsetList
LineWidth.w
X1Offset.w
X2Offset.w
ModuloOffset.w
End NEWTYPE
Dim rows.OffsetList(47)
Dim rowsq.q(47)
.Loop
MParticleFormat 0
MBitmapOrigin 0,#ObjWidth/2,#ObjHeight
MBitmapWrap 0,On
intcnt=0
SetInt 5
intcnt+1
End SetInt
buf.b=0
cnt.b=0
its.l=0
ResetTimer
While Joyb(0)=0 AND Joyb(1)=0
jh=JHoriz(1)
jv=JVert(1)
xmomentum+(xaccelerate*jh)
ymomentum+(yaccelerate*jv)
ymomentum+ygravity
If xmomentum>0
xmomentum-xairresistance
If xmomentum<0 Then xmomentum=0
Else
xmomentum+xairresistance
If xmomentum>0 Then xmomentum=0
EndIf
If xmomentum>xmaxspeed Then xmomentum=xmaxspeed
If xmomentum<-xmaxspeed Then xmomentum=-xmaxspeed
If ymomentum>ymaxspeed Then ymomentum=ymaxspeed
If ymomentum<-ymaxspeed Then ymomentum=-ymaxspeed
xpos+xmomentum
ypos+ymomentum
If ypos<0
ymomentum=-ymomentum/ytopdampen
ypos=0
EndIf
If ypos>PrefDisplayHeight-40
ymomentum=-ymomentum/ybottomdampen
ypos=PrefDisplayHeight-40
EndIf
If xpos<0 Then xpos+2240
If xpos>=2240 Then xpos-2240
If DoSky=False
MBitmapClip 0,0,0,PrefDisplayWidth,PrefDisplayHeight-60-32,On
MCls 192;0
MBitmapClip 0,Off
Else
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight-60-32,0,0,1
EndIf
If DoRainbow=False
MBoxF 0,PrefDisplayHeight-60-32,319,PrefDisplayHeight-61,0
Else
c=1
MBoxF 0,PrefDisplayHeight-60-32,319,PrefDisplayHeight-61-14,0
For yy=PrefDisplayHeight-75 To PrefDisplayHeight-61
MBoxF 0,yy,319,yy,c
c+4
Next yy
xx.q=xpos/7
For b=1 To 8
MBoxF 320-xx,PrefDisplayHeight-62,320-xx+3,PrefDisplayHeight-61,30
xx+40
If xx>319 Then xx-320
Next b
MDrawingMode MAddMode
MBoxF 139,PrefDisplayHeight-92,180,PrefDisplayHeight-61,5
MBox 139,PrefDisplayHeight-92,180,PrefDisplayHeight-61,7
MDrawingMode MColourMode
EndIf
If DoStars
MAddXYToParticlesQ &star1(1)\x,#StarsPerSpeed,-(xmomentum/60),0
MAddXYToParticlesQ &star2(1)\x,#StarsPerSpeed,-(xmomentum/50),0
MAddXYToParticlesQ &star3(1)\x,#StarsPerSpeed,-(xmomentum/40),0
MAddXYToParticlesQ &star4(1)\x,#StarsPerSpeed,-(xmomentum/30),0
MAddXYToParticlesQ &star5(1)\x,#StarsPerSpeed,-(xmomentum/20),0
MParticleFormat -1
MBitmapClip 1,On
MWrapXParticles &star1(1)\x,#StarsPerSpeed
MWrapXParticles &star2(1)\x,#StarsPerSpeed
MWrapXParticles &star3(1)\x,#StarsPerSpeed
MWrapXParticles &star4(1)\x,#StarsPerSpeed
MWrapXParticles &star5(1)\x,#StarsPerSpeed
MBitmapClip 1,Off
MPlotParticles &star1(1)\x,#StarsPerSpeed,192+14-Rnd(12)
MPlotParticles &star2(1)\x,#StarsPerSpeed,192+20-Rnd(12)
MPlotParticles &star3(1)\x,#StarsPerSpeed,192+26-Rnd(12)
MPlotParticles &star4(1)\x,#StarsPerSpeed,192+32-Rnd(12)
MPlotParticles &star5(1)\x,#StarsPerSpeed,192+38-Rnd(12)
MParticleFormat 0
EndIf
If DoLand
MScroll 160+xpos,47,PrefDisplayWidth,13,0,PrefDisplayHeight-13,2
mult.q=1.0
width.q=2240
widthadd.q=(2240-320)/47
For yy=46 To 0 Step -1
rowsq(yy)=1280-(width LSR 1)+(xpos*mult) ; 1280=1120+320-160
width-widthadd
mult-0.01825
;mult=width/2240
Next yy
rows(0)\LineWidth=320,Int(rowsq(0)),0,0
For yy=1 To 46
rows(yy)\LineWidth=320,Int(rowsq(yy))-Int(rowsq(yy-1)),0,0
Next yy
MScroll 0,0,320,47,0,PrefDisplayHeight-60,2,&rows(0)\LineWidth
EndIf
If DoObjects
MAddToParticles &pos(1)\x,#Objects,&direction(1)\x
For obj=1 To #Objects
If pos(obj)\x<0 Then pos(obj)\x+2240
If pos(obj)\x>=2240 Then pos(obj)\x-2240
If pos(obj)\y<8 OR pos(obj)\y>PrefDisplayHeight-16-#ObjHeight Then direction(obj)\y=-direction(obj)\y
Next obj
For obj=1 To #Objects
pos2(obj)\x=pos(obj)\x/7
pos2(obj)\y=PrefDisplayHeight-92+(pos(obj)\y/7)
Next obj
MAddXYToParticles &pos2(1)\x,#Objects,320-(xpos/7)-180,0
MBitmapClip 0,0,0,PrefDisplayWidth,PrefDisplayHeight,On
MWrapXParticles &pos2(1)\x,#Objects
MBitmapClip 0,Off
; MPlotParticles &pos2(1)\x,#Objects,255
ww=(#ObjWidth/7)-1
hh=(#ObjHeight/7)-1
; MDrawingMode MAddMode
For p=1 To #Objects
; MBoxF pos2(p)\x,pos2(p)\y,pos2(p)\x+ww,pos2(p)\y+hh,240+Rnd(15);10
MZoomShapeToBitmap 3,3,7,7,pos2(p)\x,pos2(p)\y,ww,hh,False,(p MOD NumberOfShapes)+1
; MMaskScrollShapeToBitmap 16,16,4,5,pos2(p)\x,pos2(p)\y,(p MOD NumberOfShapes)+1
Next p
MDrawingMode MColourMode
MPlot 160,PrefDisplayHeight-91+(ypos/7),255
MPlot 160,PrefDisplayHeight-90+(ypos/7),255
For obj=1 To #Objects
If pos(obj)\x>xpos-#ObjWidth AND pos(obj)\x<xpos+PrefDisplayWidth;-#ObjWidth+#ObjWidth
MBlit (obj MOD NumberOfShapes)+1,pos(obj)\x-xpos,pos(obj)\y
EndIf
Next obj
MBlit 0,152,ypos
EndIf
.Display
If IsAGA
Mc2p MBitmapPtr(0),PlanarBuf(buf)
If PrefDisplayBuffering>1
ShowBitMap buf
buf+1
If buf=PrefDisplayBuffering Then buf=0
EndIf
Else
*RP0.RastPort=RastPort(0)
Select PrefDisplayMethod
Case 0 ; WritePixelArray8
If PrefDisplayBuffering>1
*RP1.RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
If OSVersion<40
MUseBitmap 5
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
MUseBitmap 0
WritePixelArray8_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
Else
WriteChunkyPixels_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
EndIf
ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
Else
If OSVersion<40
MUseBitmap5
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
MUseBitmap 0
WritePixelArray8_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
Else
WriteChunkyPixels_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
EndIf
EndIf
Case 1 ; MBlockScroll
If CGFXAvail AND PrefCGFXLock
Dim CGFXTags.TagItem(1)
CGFXData.l=0
CGFXTags(0)\ti_Tag=#LBMI_BASEADDRESS,&CGFXData
CGFXTags(1)\ti_Tag=#TAG_DONE,0
LockHandle.l=LockBitMapTagList_(*RP0\BitMap,&CGFXTags(0))
MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,CGFXData
Else
MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,*RP0\BitMap\Planes
EndIf
If PrefDisplayBuffering>1
*RP1.RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,PrefDisplayHeight+(cnt*PrefDisplayHeight),0 ; From modulo bitmap
ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
Else
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From modulo bitmap
EndIf
MUseBitmap 0
If CGFXAvail AND (LockHandle<>0) AND PrefCGFXLock Then UnLockBitMap_ LockHandle
Case 2 ; CGFXWriteChunkyPixels
If PrefDisplayBuffering>1
*RP1.RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP1,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
Else
WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
EndIf
End Select
EndIf
; If intcnt<=2 Then VWait Else intcnt=0 ; only wait for 25fps if faster
its+1
Wend
;Report
t=Timer
t=Max(t,1)
its=Max(its,1)
a.q=50.0/(t/its)
WBenchToFront_
WbToScreen 1
Window 2,16,16,300,40,0,"Test results",1,0
WindowOutput 2
NPrint a," frames per second"
NPrint " "
NPrint "Press mouse/joy button..."
VWait 20
Repeat
Until Joyb(0)<>0 OR Joyb(1)<>0
Finish:
End